home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / gsdb21.arc / GS_SCRN.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-04  |  6KB  |  266 lines
  1. unit GS_Scrn;
  2.  
  3. interface
  4.  
  5. uses
  6.     Crt,
  7.     Dos;
  8.  
  9. Type
  10.    GS_Scrn_Str80  =  string[80];
  11.  
  12. var
  13.    GS_Scrn_ScB : Boolean;
  14.    GS_Scrn_Segmt : word;
  15.    GS_Scrn_Mode  : integer;
  16.  
  17.  
  18. procedure GS_Scrn_Await_Key;
  19.  
  20. procedure GS_Scrn_Get_Win(x1,y1,x2,y2 : integer;var HS);
  21.  
  22. procedure GS_Scrn_Put_Win(x1,y1,x2,y2 : integer; var HS);
  23.  
  24. procedure GS_Scrn_Put_Atr(cx,cy,bx,by,f,b : integer);
  25.  
  26. procedure GS_Scrn_Put_Char(cx,cy : integer; ch : char);
  27.  
  28. {procedure GS_Scrn_Swap_Char(cx,cy : integer; ch : char);}
  29.  
  30. Procedure GS_Scrn_SetCursor(c : boolean);
  31.                                       {Sets big cursor if argument is true;}
  32.                                       {Sets small cursor if false}
  33. Procedure GS_Scrn_HideCursor;
  34. Procedure GS_Scrn_ShowCursor;
  35.  
  36. implementation
  37.  
  38. type
  39.    stype = array [1..25,1..80] of word;
  40.  
  41. var
  42.    Scrn_p : ^stype;
  43.    reg    : Registers;
  44. {.pa}
  45. {
  46.          ┌──────────────────────────────────────────────────────────┐
  47.          │  ********     Screen Cursor Size Routines      *******   │
  48.          │                                                          │
  49.          │  The next three routines are used to change the size of  │
  50.          │  the screen cursor to indicate whether insert is on or   │
  51.          │  off.  BIOS calls are used.                              │
  52.          └──────────────────────────────────────────────────────────┘
  53. }
  54.  
  55. PROCEDURE LineCursor;                 {Set cursor to two lines}
  56. BEGIN
  57.    reg.ah := $03;                     {Service 3 }
  58.    INTR($10,reg);                     {Intr 10. Get scan lines}
  59.    reg.ah := $01;                     {Service 1 }
  60.    reg.ch := reg.cl-1;                {Set two line difference }
  61.    INTR($10,reg);                     {Interrupt 10.  Set scan lines}
  62. END;
  63.  
  64. PROCEDURE BigCursor;                  {Set cursor to four lines}
  65. BEGIN
  66.    reg.ah := $03;                     {Service 3 }
  67.    INTR($10,reg);                     {Intr 10. Get scan lines}
  68.    reg.ah := $01;                     {Service 1 }
  69.    reg.ch := reg.cl - 3;              {Set four scan lines for cursor}
  70.    INTR($10,reg);                     {Interrupt 10.  Set scan lines }
  71. END;
  72.  
  73. procedure GS_Scrn_SetCursor(c : boolean);
  74.                                       {Sets big cursor if argument is true;}
  75.                                       {sets small cursor otherwise.}
  76. begin
  77.    if c then BigCursor else LineCursor;
  78. end;
  79.  
  80. PROCEDURE GS_Scrn_HideCursor;
  81. BEGIN
  82.    reg.ah := $03;                 { Service 3 }
  83.    INTR($10,reg);                 { Intr 10. Get scan lines}
  84.    reg.cx := reg.cx OR $2000;     { Set bit 5 to 1}
  85.    reg.ah := $01;                 { Service 1 }
  86.    INTR($10,reg);                 { Intr 10 resets cursor}
  87. END;
  88.  
  89. PROCEDURE GS_Scrn_ShowCursor;
  90. BEGIN
  91.    reg.ah := $03;               { Service 3 }
  92.    INTR($10,reg);               { Intr 10. Get scan lines}
  93.    reg.cx := reg.cx AND $DFFF;  { Set bit 5 to 0}
  94.    reg.ah := $01;               { Service 1 }
  95.    INTR($10,reg);               { Intr 10 resets cursor}
  96. END;
  97.  
  98.  
  99. procedure GS_Scrn_Put_Char(cx,cy : integer; ch : char);
  100. var
  101.    valu : word;
  102. BEGIN
  103.    valu := (TextAttr shl 8) + byte(ch);
  104.    scrn_p^[cy,cx] := valu;
  105. END;
  106.  
  107. procedure GS_Scrn_Swap_Char(cx,cy : integer; ch : char);
  108. var
  109.    valu,
  110.    hold : word;
  111. BEGIN
  112.    valu := (TextAttr shl 8) + byte(ch);
  113.    hold := scrn_p^[cy,cx];
  114.    scrn_p^[cy,cx] := valu;
  115.    scrn_p^[cy,cx+1] := hold;
  116. END;
  117.  
  118.  
  119.  
  120.  
  121.  
  122. procedure GS_Scrn_Await_Key;
  123. var
  124.    wsmin,
  125.    wsmax     : word;
  126.    wscx,
  127.    wscy,
  128.    wsattr    : byte;
  129.    ch        : char;
  130.    Scrn      : Array [1..4000] of byte;
  131.    lopx,
  132.    lopy      : integer;
  133.    hour,
  134.    minute,
  135.    second,
  136.    sec100,
  137.    minhold   : word;
  138.  
  139. begin
  140.    GetTime(hour,minute,second,sec100);
  141.    minhold := minute + 5;
  142.    if minhold > 59 then minhold := minhold - 59;
  143.    while minute <> minhold do
  144.    begin
  145.       if KeyPressed then exit;
  146.       GetTime(hour,minute,second,sec100);
  147.    end;
  148.    Randomize;
  149.    move(mem[GS_Scrn_Segmt:0], scrn, 4000);
  150.    wsmin := WindMin;
  151.    wsmax := WindMax;
  152.    wsattr := TextAttr;
  153.    wscx := wherex;
  154.    wscy := wherey;
  155.    window (1,1,80,25);
  156.    TextColor(LightGray);
  157.    TextBackground(Black);
  158.    lopx := 37;
  159.    lopy := 17;
  160.    ClrScr;
  161.    gotoxy(lopx, lopy);
  162.    write('Press Any Key to Start');
  163.    while not KeyPressed do
  164.    begin
  165.       GetTime(hour,minute,second,sec100);
  166.       if minute <> minhold then
  167.       begin
  168.          minhold := minute;
  169.          lopx := random(56) + 1;
  170.          lopy := random(23) + 1;
  171.          ClrScr;
  172.          gotoxy(lopx, lopy);
  173.          write('Press Any Key to Start');
  174.       end;
  175.    end;
  176.    ch := ReadKey;
  177.    if ch = #0 then ch := ReadKey;
  178.    move(scrn, mem[GS_Scrn_Segmt:0], 4000);
  179.    WindMin := wsmin;
  180.    WindMax := wsmax;
  181.    TextAttr := wsattr;
  182.    gotoxy(wscx,wscy);
  183. end;
  184.  
  185.  
  186. procedure GS_Scrn_Get_Win(x1,y1,x2,y2 : integer; var HS);
  187. var
  188.    i,j,x,y  : integer;
  189.    HoldStr : array [1..2000] of word absolute HS;
  190. begin
  191.    i := 0;
  192.    for y := y1 to y2 do
  193.    begin
  194.       for x := x1 to x2 do
  195.       begin
  196.          inc(i);
  197.          HoldStr[i] := scrn_p^[y,x];
  198.       end;
  199.    end;
  200. end;
  201.  
  202. procedure GS_Scrn_Put_Win(x1,y1,x2,y2 : integer; var HS);
  203. var
  204.    i,j,x,y  : integer;
  205.    HoldStr : array [1..2000] of word absolute HS;
  206. begin
  207.    i := 0;
  208.    for y := y1 to y2 do
  209.    begin
  210.       for x := x1 to x2 do
  211.       begin
  212.          inc(i);
  213.          scrn_p^[y,x] := HoldStr[i];
  214.       end;
  215.    end;
  216. end;
  217.  
  218. procedure GS_Scrn_Put_Atr(cx,cy,bx,by,f,b : integer);
  219. var
  220.    i,j,x,y : integer;
  221.    x1, y1, x2, y2  : word;
  222.    c,v,t,g : word;
  223. begin
  224.    if f > 15 then v := 128 else v := 0;
  225.    t := f mod 16;
  226.    g := b mod 8;
  227.    c := (g shl 4) + t + v;
  228.    c := c shl 8;
  229.    x1 := cx + lo(WindMin);
  230.    y1 := cy + hi(WindMin);
  231.    x2 := bx + lo(WindMin);
  232.    y2 := by + hi(WindMin);
  233.    for y := y1 to y2 do
  234.    begin
  235.       for x := x1 to x2 do
  236.       begin
  237.          scrn_p^[y,x] := c + lo(scrn_p^[y,x]);
  238.       end;
  239.    end;
  240. end;
  241.  
  242. function Dos_Mode : integer;
  243. begin
  244.    GS_Scrn_Mode := LastMode;
  245.    if GS_Scrn_Mode = Mono then
  246.    begin
  247.       TextMode(Mono);
  248.       GS_Scrn_Segmt := $B000;
  249.    end
  250.    else
  251.    begin
  252.       TextMode(CO80);
  253.       GS_Scrn_Segmt := $B800;
  254.    end;
  255.    Dos_Mode := GS_Scrn_Mode;
  256. end;
  257.  
  258.  
  259.  
  260. begin
  261.    GS_Scrn_ScB := false;
  262.    GS_Scrn_Mode:= Dos_Mode;
  263.    TextColor(LightGray);
  264.    TextBackGround(Black);
  265.    scrn_p := ptr(GS_Scrn_Segmt,0);
  266. end.